home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
IRIX Installation Tools & Overlays 2002 November
/
SGI IRIX Installation Tools & Overlays 2002 November - Disc 4.iso
/
dist
/
cluster_admin.idb
/
var
/
cluster
/
ha
/
diags
/
libdiags.pl.z
/
libdiags.pl
Wrap
Perl Script
|
2002-10-15
|
93KB
|
3,240 lines
#!/usr/sbin/perl
#
# Copyright (C) 1998-2000, Silicon Graphics, Inc.
# All Rights Reserved.
#
# UNPUBLISHED -- Rights reserved under the copyright laws of the United
# States. Use of a copyright notice is precautionary only and does not
# imply publication or disclosure.
#
# THIS SOFTWARE CONTAINS CONFIDENTIAL AND PROPRIETARY INFORMATION OF
# SILICON GRAPHICS, INC. ANY DUPLICATION, MODIFICATION, DISTRIBUTION, OR
# DISCLOSURE IS STRICTLY PROHIBITED WITHOUT THE PRIOR EXPRESS WRITTEN
# PERMISSION OF SILICON GRAPHICS, INC.
#
# U.S. GOVERNMENT RESTRICTED RIGHTS LEGEND
# Use, duplication or disclosure by the Government is subject to
# restrictions as set forth in FAR 52.227.19(c)(2) or subparagraph
# (c)(1)(ii) of the Rights in Technical Data and Computer Software
# clause at DFARS 252.227-7013 and/or in similar or successor clauses
# in the FAR, or the DOD or NASA FAR Supplement. Unpublished-- rights
# reserved under the copyright laws of the United States.
# Contractor/manufacturer is Silicon Graphics, Inc.,
# 2011 N. Shoreline Blvd., Mountain View, CA 94039-7311.
#
# General perl library for ClusterDiags to use
require "ctime.pl";
select(STDERR); $| = 1;
select(STDOUT); $| = 1;
use POSIX;
# NodetoHostname
# Convert the nodename to the actual hostname and place it
# in a global hash table.
sub NodetoHostname {
local (@nodes,$node);
local ($cmd);
local (@tmp);
local ($line);
local ($name, $val);
%NodeToHost = (); # Clear the table.
@nodes=GetAllMachines();
if (scalar (@nodes) < 1) {
&Failure("No machines configured");
exit(1);
}
foreach $node (@nodes) {
$cmd="$CLI_PATH/machineQuery _NUM_MACHINES=1 _MACHINE_0=$node";
@tmp=&do_cmd_with_timeout($cmd,10);
foreach $line (@tmp) {
($name,$val)=split(': ',$line);
if ( $line =~ /Hostname/ ) {
&Log("Node %s associated with hostname %s.",$node,$val);
$NodeToHost{$node}=$val;
}
}
}
return $node;
}
sub alarm_call {
local($pack, $file, $line, $subname, $hasargs, $wantarray);
($pack, $file, $line, $subname, $hasargs, $wantarray)=caller(1);
&Failure("rsh Command timeout: SubName:%s Line:%d",$subname,$line);
$SIG_TIMEOUT=1;
}
# rsh
# Special implementation of the rsh command.
#
# Calling sequence
#
# @output=rsh("machinename.domain.com","date");
# if ($output[0] eq $NULL) {
# printf("Error encountered\n");
# } else {
# ...
# }
sub rsh {
local ($node,$cmd) = @_;
local ($command);
local ($hostname);
local (@output,$i,@retv);
local ($old_sig);
if ($node eq $NULL) {
&InternalError(__LINE__,__FILE__,"Must supply a host\n");
return ($NULL);
}
if ($cmd eq $NULL) {
&InternalError(__LINE__,__FILE__,"Must supply a command\n");
return ($NULL);
}
$hostname=$NodeToHost{$node};
if (! defined($hostname) || $hostname eq "") {
$hostname=$node;
}
if (gethostbyname($hostname) eq "") {
&InternalError(__LINE__,__FILE__,"No such host %s [%s]\n",$host,
$hostname);
return ($NULL);
}
# create a temporay script file to be interpreted by /bin/sh on the other
# node
open (scr_file, "> /tmp/s1");
print scr_file $cmd, "\n";
print scr_file "echo \$\?", "\n";
close(scr_file);
`/usr/bsd/rcp /tmp/s1 $hostname:/tmp/s1`;
$error_code=$?;
if ( $error_code != 0 ) {
$RSH_ERRNO=1;
$local_host=`hostname`;
chop($local_host);
&Failure("Connection to $hostname from $local_host failed");
&Suggest("(1) Ensure node '$hostname' has superuser access from $local_host");
&Suggest("(2) Ensure address '$hostname' is valid.");
return ($NULL);
}
$command="/usr/bsd/rsh $hostname '/bin/sh /tmp/s1'";
&Log("Executing command $command");
$old_sig = $SIG{'ALRM'};
$SIG{'ALRM'} = \&alarm_call;
alarm (60);
eval {@output=`$command`};
alarm (0);
$SIG{ALRM} = $old_sig;
# clean up the temporary file created, one of the unlink becomes
# unnecessary if the machine from which diags are run belongs to
# the cluster. So need to test the existence of file before
# deleting it.
`/usr/bin/test -f /tmp/s1 && /bin/rm /tmp/s1`;
`/usr/bsd/rsh $hostname '/usr/bin/test -f /tmp/s1 && /bin/rm /tmp/s1'`;
if ($SIG_TIMEOUT) {
$RSH_ERRNO=1;
return $NULL;
}
if ($@ ne "") {
&Failure("command failure $@\n");
return ($NULL);
}
$RSH_ERRNO=$output[scalar(@output)-1];
chomp(@output);
for ($i=0; $i < scalar(@output)-1; $i++) {
$retv[$i]=$output[$i];
}
if ($verbose) {
# For debugging purposes only.
printf("IP:$command\n");
for ($i=0; $i < scalar(@retv); $i++) {
printf("OP: $retv[$i]\n");
}
}
return(@retv);
}
# TailLogFile
# Print out the last 5 lines from the log file
sub TailLogFile
{
local ($node,$file) = @_;
local ($cmd,@output);
local ($line,$i);
$cmd="tail -5 $LOG_DIR/$file";
@output=&rsh($node,$cmd);
&Notice("Check file $LOG_DIR/$file on node $node (hostname $NodeToHost{$node}) for more information\n");
&Notice("Last 5 entires from script log file ...\n");
if ($RSH_ERRNO == 0 ) {
for ($i=0; $i < scalar(@output); $i++) {
printf("$output[$i]\n");
}
printf("\n");
}
}
# PrintStatus
# Print some exit status information
sub PrintStatus
{
&Notice("overall exit status:%s, tests failed:%d, total tests executed:%d",
($CD_ERRNO?"success":"failed"),$CD_ERRCNT,$CD_TESTCNT);
&Log("overall exit status:%s, test failed:%d, total tests:%d",
($CD_ERRNO?"success":"failed"),$CD_ERRCNT,$CD_TESTCNT)
}
# ExitStatus
# Keep track of total fails, total tests and
# and the overall test code.
#
sub ExitStatus
{
local ($code) = @_;
&LogEntry();
if ($code == $CD_FAILURE) {
$CD_ERRNO=$CD_FAILURE;
$CD_ERRCNT++;
&Debug("incrementing error counter %d",$CD_ERRCNT);
}
$CD_TESTCNT++;
}
# CheckMACSyntax
# Check that the MAC_address has the correct syntax
# E.g. a:b:c:d
#
sub CheckMACSyntax {
local ($address) = @_;
$address=~s/\"//g;
&Debug("Checking MAC address %s",$address);
if ($address =~ /\w+\:\w+\:\w+\:\w+\:\w+\:(\w+)/ ) {
return $CD_SUCCESS;
}
return $CD_FAILURE;
}
# CheckIPSyntax
# Check that the IP_address hash the correct syntax
# E.g. a.b.c.d
#
sub CheckIPSyntax {
local ($address) = @_;
&LogEntry();
$address=~s/\"//g;
&Debug("Checking IP address %s",$address);
if ($address =~ /\d+\.\d+\.\d+\.(\d+)/ ) {
return $CD_SUCCESS;
}
return $CD_FAILURE;
}
# CheckNetSyntax
# Check that the Network address is a valid hex number
# E.g. ffffff00
#
sub CheckNetSyntax {
local ($network) = @_;
&LogEntry();
$network=~s/\"//g;
if ($network =~ /^0x/) {
if ($network=hex($network)) {
if ($network > 0) {
return $CD_SUCCESS;
}
}
}
return $CD_FAILURE;
}
# CheckInterface
# Check that the Interface exists on the machine
# PV 669915: The interface argument may be a command seperated list.
# But I don't want to change the overall methods like pulloff
# so I use index to search for the interface name in the
# supplied argument $interface.
#
sub CheckInterface{
local ($machine, $interface) = @_;
local ($if, $found, $junk);
local (@res);
local ($pos);
&LogEntry();
@res=&rsh($machine,"/usr/etc/netstat -in");
if ($RSH_ERRNO != 0) {
&Failure("timeout talking with %s",$machine);
return $CD_FAILURE;
}
$found=0;
chomp(@res);
foreach $if (@res) {
($name, $junk)=split(' ',$if);
# For some reason, the parameters are quoted !!!
$interface=~s/\"//g;
$name=~s/\"//g;
$pos=-1;
while (($pos=index($interface,$name,$pos)) > -1) {
&Log("found interface name %s, in CDB interface list %s",$name,$interface);
$found =1;
$pos++;
}
}
if (!$found) {
return $CD_FAILURE;
}
return $CD_SUCCESS;
}
# AutoLoad
# Dynamically look for resource perl scripts, if a match is
# the load the module/file.
#
sub AutoLoad
{
local (@resources) = @_;
local (@fds, $fd);
local ($res,$file);
local ($found)=0;
if(!opendir(HDL,$LibDiagsPath)) {
&Error(1,"failed to open %s",$LibDiagsPath);
return ($found);
}
@fds=readdir(HDL);
closedir(HDL);
foreach $res (@resources) {
foreach $fd (@fds) {
$file="$res.pl";
if ($fd eq $file) {
&Debug("autoloading file %s/%s",$LibDiagsPath,$file);
require "$LibDiagsPath/$file";
$found=1;
}
}
}
return($found);
}
# ExitGracefully
# Exit back to the command line with the specified exit code
#
sub ExitGracefully
{
local($return_code) = @_;
&CleanUp();
exit($return_code);
}
# MakeTempFile
# make a temporary file at location $dir
#
sub MakeTempFile
{
local($dir,$comment) = @_;
local($count,$file,$status,@call_info);
if ($comment eq "") { $comment = (caller(1))[3]; }
for ($count = 0; $count < 10000; $count++) {
$file = "$dir/libdiags$$_$count";
if (-e $file) { next; }
$status = open(OUT,">$file");
if ($status == 0) { last; }
close(OUT);
push(@files_to_clean,"$file:$comment");
return($file);
}
&InternalError(__LINE__,__FILE__,
"MakeTempFile Can't Create Temp File In %s\n",$dir);
}
# LogEntry
# Writes the caller entery point to the log file
#
sub LogEntry
{
local($pack, $file, $line, $subname, $hasargs, $wantarray);
($pack, $file, $line, $subname, $hasargs, $wantarray)=caller(1);
&Debug("Package:%s File:%s Line:%d SubName:%s Hasargs:%s Wantarray:%s",
$pack, $file, $line, $subname, $hasargs, $wantarray);
}
# Log
# Writes a message to the FailSafe diagnostic file, at normal log level.
#
sub Log
{
local($msg,@args) = @_;
local($buffer,$cmd);
local($package, $filename, $line);
($package, $filename, $line)=caller(1);
$buffer=sprintf($msg,@args);
$cmd="/usr/cluster/bin/ha_cilog -l 1 -g diags -s diags \"$package:$filename:$line $buffer\"";
do_log($cmd,10);
}
# Debug
# Writes a message to the FailSafe diagnostic file, at the debug level.
#
sub Debug
{
local($msg,@args) = @_;
local($buffer,$cmd);
local($package, $filename, $line);
($package, $filename, $line)=caller(1);
$buffer=sprintf($msg,@args);
$cmd="/usr/cluster/bin/ha_cilog -l 10 -g diags -s diags \"$package:$filename:$line $buffer\"";
do_log($cmd,10);
}
# Notice
# Writes a message to standard output.
#
sub Notice
{
local($msg,@args) = @_;
print STDERR &PrefixifyMultiLineString("Notice: ",
sprintf($msg,@args));
print STDERR "\n";
}
# Verbose
# Writes a message to standard output.
#
sub Verbose {
local($msg,@args) = @_;
if ($verbose) {
print STDERR &PrefixifyMultiLineString("",sprintf($msg,@args));
print STDERR "\n";
}
}
# Verbose
# Writes a message to standard output.
#
sub Failure {
local($msg,@args) = @_;
print STDERR &PrefixifyMultiLineString("Failure: ",
sprintf($msg,@args));
print STDERR "\n";
}
# Suggest
# Writes a message to standard output.
#
sub Suggest
{
local($msg,@args) = @_;
print STDERR &PrefixifyMultiLineString("Suggestion: ",
sprintf($msg,@args));
print STDERR "\n";
}
# Warning
# Writes a message to standard output.
#
sub Warning
{
local($msg,@args) = @_;
print STDERR &PrefixifyMultiLineString("Warning: ",
sprintf($msg,@args));
print STDERR "\n";
}
# Success
# Writes a message to standard output.
#
sub Success
{
local($msg,@args) = @_;
print STDERR &PrefixifyMultiLineString("Success: ",
sprintf($msg,@args));
print STDERR "\n";
}
# Status
# Writes a message to standard output.
#
sub Status
{
local($msg,@args) = @_;
print STDERR &PrefixifyMultiLineString("Status: ",
sprintf($msg,@args));
print STDERR "\n";
}
# Error
# Writes a message to standard output, then calls ExitGracefully to exit
# back to the command line.
#
sub Error
{
local($terminate,$msg,@args) = @_;
local($format,$errno,$errmsg);
$errno = $!;
$errmsg = "$!";
print STDERR &PrefixifyMultiLineString("Error: ",
sprintf($msg,@args));
print STDERR "\n";
if ($terminate != 0) { &ExitGracefully($terminate); }
}
# InternalError
# Writes a message to statdard output. Containg the file,line and errno
# of the failing command.
#
sub InternalError
{
local($linenumber,$file,$msg,@args) = @_;
local($prefix,$errno,$errmsg);
$errno = $!;
$errmsg = "$!";
$prefix = sprintf("INTERNAL ERROR: (file %s, line %d, errno %d): ",
$file,$linenumber,$errno);
print STDERR &PrefixifyMultiLineString($prefix,
sprintf($msg,@args));
&CleanUp();
&ExitGracefully(1);
}
sub OnTheSameNode
{
local ($node) = @_;
local ($this_node);
local ($h_name1,$h_aliases1,$h_addrtype1,$h_len1,@h_addrs1);
local ($h_name2,$h_aliases2,$h_addrtype2,$h_len2,@h_addrs2);
$this_host=`/sbin/uname -n`;
chop ($this_host);
($h_name1,$h_aliases1,$h_addrtype1,$h_len1,@h_addrs1) = gethostbyname($NodeToHost{$node});
($h_name2,$h_aliases2,$h_addrtype2,$h_len2,@h_addrs2) = gethostbyname($this_host);
if ($h_name2 eq $h_name1) {
return 1;
}
return 0;
}
# ExecuteScript
# Executes a FailSafe script (start/stop/probe ...) on a remote
# machine.
#
sub ExecuteScript
{
local ($machine, $resource, $type, $script) = @_;
local ($cmd);
local ($res,@output);
local ($retv,$this_host);
local ($name, $code);
$retv=0;
&LogEntry();
# Create the script input file
$this_host=`/sbin/uname -n`;
chop($this_host);
if (!&OnTheSameNode($machine)) {
&Notice("Resource Destructive tests can only be executed on the local host");
&Log("Can only execute the resource destructive tests on local host %s/%s",
$this_host, $NodeToHost{$machine});
return $CD_FAILURE;
}
$cmd="/sbin/rm -f /tmp/testip /tmp/testop; /sbin/echo \"$resource\" > /tmp/testip";
@output=&do_cmd_with_timeout($cmd,60);
if ($RSH_ERRNO != 0 ) {
&Failure("failed to create test file on machine %s",$machine);
return 0;
}
&Log("Executing $script script using resource $resource");
$cmd="$RESOURCE_PATH/$type/$script /tmp/testip /tmp/testop";
@output=&do_cmd_with_timeout($cmd,120);
if ($RSH_ERRNO != 0 ) {
&Failure("resource %s of resource_type %s failed on machine %s",$resource, $type, $machine);
}
$cmd="cat /tmp/testop";
@output=&do_cmd_with_timeout($cmd,60);
if ( $RSH_ERRNO != 0 ) {
&Failure("failed to read script output file %s\n",$cmd);
return 0;
}
foreach $res (@output) {
($name, $code)=split(' ',$res);
$code=hex($code);
&Log("returned code for resource %s script %s of type %s is %d",
$resource,$script,$type,$code);
if (($script ne $HA_EXCLUSIVE) && ($code == $HA_SUCCESS)) {
&Debug("script \"%s\" returned \"%s\" for resource \"%s\"",
$script, "Success", $resource);
} elsif (($script eq $HA_EXCLUSIVE) && ($code == $HA_NOT_RUNNING)) {
&Debug("script \"%s\" returned \"%s\" for resource \"%s\"",
$script,"Not Running",$resource);
} elsif ($code == $HA_INVAL_ARGS) {
&Failure("script \"%s\" returned \"%s\" for resource \"%s\"",
$script,"Invalid Arguments",$resource);
&TailLogFile($machine,"script_$this_host");
return 0;
} elsif (($script ne $HA_EXCLUSIVE) && ($code == $HA_CMD_FAILED)) {
&Failure("script \"%s\" returned \"%s\" for resource \"%s\"",
$script,"Command Failed",$resource);
&TailLogFile($machine,"script_$this_host");
return 0;
} elsif (($script eq $HA_EXCLUSIVE) && ($code == $HA_RUNNING)) {
&Failure("script \"%s\" returned \"%s\" for resource \"%s\"",
$script,"Running",$resource);
&TailLogFile($machine,"script_$this_host");
return 0;
} elsif ($code == $HA_NOTSUPPORTED) {
&Failure("script \"%s\" returned \"%s\" for resource \"%s\"",
$script,"Not Supported",$resource);
&TailLogFile($machine,"script_$this_host");
return 0;
} elsif ($code == $HA_NOCFGINFO) {
&Failure("script \"%s\" returned \"%s\" for resource \"%s\"",
$script,"Bad config",$resource);
&TailLogFile($machine,"script_$this_host");
return 0;
} else {
&Failure("Returned %d from %s script is undefined",
$code,$script);
return 0;
}
}
return 1;
}
# GetResFromResType
# Returns the output from resourceEnumerate CLI. I.e. shows all the
# configured resources.
#
sub GetResFromResType {
local ($machine, $type) = @_;
local (@output,@tmp);
local ($cmd,$val,$junk,$rtype,$i);
$cmd="$CLI_PATH/resourceEnumerate _CLUSTER=$Cluster _RESOURCE_TYPE=$type";
@tmp=&rsh($machine,$cmd);
if ($RSH_ERRNO != 0) {
return $NULL;
}
$i=0;
foreach $line (@tmp) {
($val, $junk, $rtype) = split(" ",$line);
if ($rtype eq $type) {
$output[$i]=$val;
$i++;
}
}
return (@output);
}
sub GetResGroupType {
local ($line) = @_;
local ($a,$b);
($a, $b) = split("type: ",$line);
$b=~s/[)]//g;
return $b;
}
sub GetResGroupName {
local ($line) = @_;
local ($a,$b,$c);
($a,$b) = split("type:",$line);
$a=~s/[(]//g;
return $a;
}
# GetGroupContents
# Returns an array of resource, and type
#
sub GetGroupContents {
local ($name)=@_;
local (@tmp,@output);
local ($cmd,$i,$cnt);
$cmd="$CLI_PATH/resgroupEnumerateResources _CLUSTER=$Cluster _RESOURCE_GROUP=$name";
@tmp=&do_cmd_with_timeout($cmd,10);
$cnt=scalar(@tmp);
for ($i=0; $i < ($cnt-1); $i++) {
$tmp[$i+1]=~s/\t//g;
$output[$i]=$tmp[$i+1];
}
return (@output);
}
# GetFailoverContents
# Returns an array of police information.
#
sub GetFailoverContents {
local ($policy)=@_;
local (@tmp,@output);
local ($cmd,$i,$cnt);
local ($ptmp);
$cmd="$CLI_PATH/failoverQuery _FAILOVER_POLICY=$policy";
@tmp=&do_cmd_with_timeout($cmd,10);
$cnt=scalar(@tmp);
if (scalar(@tmp) < 2) {
&Warning("%s",$tmp[0]);
return (@output);
}
for ($i=0; $i < ($cnt-1); $i++) {
$tmp[$i+1]=~s/\t//g;
$output[$i]=$tmp[$i+1];
}
return (@output);
}
# GetGroupFailoverPolicy
# Returns the failover policy for the resource group.
#
sub GetGroupFailoverPolicy {
local ($group)=@_;
local (@tmp, @output);
local ($cmd,$i,$cnt);
local ($ptmp);
local ($line);
local ($name, $val);
$cmd="$CLI_PATH/resgroupQuery _RESOURCE_GROUP=$group _CLUSTER=$Cluster";
@tmp=&do_cmd_with_timeout($cmd,10);
foreach $line (@tmp) {
($name,$policy)=split(': ',$line);
if ( $line =~ /Failover Policy/ ) {
&Debug("Resource group %s has failover policy %s",$group,$policy);
return $policy;
}
}
return $policy;
}
#
# GetMachinesinGroupAFD
# Returns the list of machines in resource group's failover
# policy AFD.
sub GetMachinesinGroupAFD {
local ($group)=@_;
local (@machines);
local ($policy);
# Get resource group failover policy
$policy=&GetGroupFailoverPolicy($group);
if (! ($policy)) {
&Failure("Resource group %s not present", $group);
return (@machines);
}
@attribs=&GetFailoverContents($policy);
if (scalar(@attribs) < 2) {
&Failure("Resource group %s Policy %s is not defined", $group, $policy);
} else {
foreach $line (@attribs) {
($key, $value) = split(":",$line);
if ($key=~/.*Initial AFD/) {
$afd=$value;
$afd=~ s/\s//;
@machines=split(" ", $afd);
}
}
}
return (@machines);
}
# GetAllConfiguredGroups
# Returns the output from resgroupsEnumerate CLI. I.e show all the
# configured resource groups.
#
sub GetAllConfiguredGroups {
local (@tmp,@output);
local ($cmd,$i,$cnt);
$cmd="$CLI_PATH/resgroupsEnumerate _CLUSTER=$Cluster";
@tmp=&do_cmd_with_timeout($cmd,10);
$cnt=scalar(@tmp);
for ($i=0; $i < ($cnt-1); $i++) {
$tmp[$i+1]=~s/.*\t//g;
$output[$i]=$tmp[$i+1];
}
return (@output);
}
# GetAllConfiguredPolices
# Returns the output from failoverEnumerate CLI. I.e show all the
# configured failover policies.
#
sub GetAllConfiguredPolicies {
local (@tmp,@output);
local ($cmd,$i,$cnt);
$cmd="$CLI_PATH/failoverEnumerate";
@tmp=&do_cmd_with_timeout($cmd,10);
$cnt=scalar(@tmp);
for ($i=0; $i < ($cnt-1); $i++) {
$tmp[$i+1]=~s/.*\t//g;
$output[$i]=$tmp[$i+1];
}
return (@output);
}
# GetAllConfiguredResources
# Returns the output from restypeEnumerate CLI. I.e show all the configured
# resource types.
#
sub GetAllConfiguredResources {
local (@output);
local ($cmd);
$cmd="$CLI_PATH/restypeEnumerate _CLUSTER=$Cluster";
@output=&do_cmd_with_timeout($cmd,10);
return (@output);
}
# GetResParameters
# Returns the output from resourceQuery CLI. I.e show all parameters for a particular
# resource.
#
sub GetResParameters {
local ($machine, $type, $name)= @_;
local (@output);
local ($cmd,$line,$pos);
$cmd="$CLI_PATH/resourceQuery _CLUSTER=$Cluster _RESOURCE_TYPE=$type _RESOURCE=$name";
@output=&rsh($machine,$cmd);
if ($RSH_ERRNO != 0) {
return $NULL;
}
$pos=-1;
foreach $line (@output) {
if(($pos=strstr("Internal error",$line)) > -1) {
return -1;
}
}
return (@output);
}
# GetResDependency
# Returns the output from resourceQuery CLI. I.e show all resource dependencies for
# a particular resource.
#
sub GetResDependency {
local ($machine,$type,$name)=@_;
local (@tmp,$cmd,@args);
local ($line,$ptr1,$ptr2);
local ($popluate,$found);
$cmd="$CLI_PATH/resourceQuery _ALL=true _CLUSTER=$Cluster _RESOURCE_TYPE=$type _RESOURCE=$name";
@tmp=&rsh($machine,$cmd);
if ($RSH_ERRNO != 0) {
return $NULL;
}
# Make some attempt to parse the dependency list.
$found=0;
$populate=0;
foreach $line (@tmp) {
($ptr1, $ptr2) = split(" ",$line);
if ($populate) {
$args[$found]=$ptr1;
$args[++$found]=$ptr2;
$found++;
}
if ($line =~ /Resource dependencies/) {
$populate=1;
}
}
if ($found == 0) {
return -1;
}
return (@args);
}
# pulloff
# Looks for a particular resource parameter in the input list, and returns the
# assocaiated value.
#
sub pulloff {
local ($type, @list) =@_;
local ($name, $val);
local ($pair);
foreach $pair (@list) {
($name, $val)=split(" ",$pair);
if ($name eq $type) {
# remove all leading white space
$val=~s/^\s*(.*?)\s*/$1/;
return $val;
}
}
return "";
}
# ExistResourcesOnDisk
# Returns the installed resource types.
#
sub ExistResourcesOnDisk{
local ($machine,$res) = @_;
local ($flag) = 0;
local (@output, $cmd,$pos);
$cmd="$CLI_PATH/restypeInstallEnumerate _CLUSTER=$Cluster";
@output = &rsh($machine,$cmd);
if ($RSH_ERRNO != 0) {
return $NULL;
}
$flag=0;
$type=~s/\"//g; # Remove any quotes
$pos=-1;
foreach $type (@output) {
if (($pos=strstr($type,$res)) > -1) {
$flag=1;
}
}
return $flag;
}
# ResourcesExists
# Uses the cdbutil CLI to build a name space tree.
#
sub ResourcesExists {
local ($machine) = @_;
local ($who);
local ($flag) = 0;
$who = "#cluster#$Cluster#HA";
&get_tree($machine_name, $who);
for ($i= 0; $i <= $No_of_children{$who}; $i++) {
if ($child{$who, $i} eq "resources") {
if ($value_me{$who, $child{$who, $i}, $i} eq '<tree>') {
$flag = 1;
}
}
}
return ($flag);
}
# GetAllMachines
# Returns all configured machines.
#
sub GetAllMachines {
local (@output,@tmp);
local ($cmd,$i,$populate,$ptr1,$ptr2);
local ($line);
$cmd="$CLI_PATH/machineEnumerate";
@tmp=&do_cmd_with_timeout($cmd,10);
chomp(@tmp);
# Make some attempt to parse the dependency list.
$i=0;
$populate=0;
foreach $line (@tmp) {
if ($populate) {
$line =~ s/\s//;
if ($line ne "") {
$output[$i]=$line;
$i++;
}
}
if ($line=~/.*Machine*/) {
$populate=1;
}
}
# Issue an error since there are no machines configured
if (scalar(@output) < 1) {
&Failure("No machines are configured: %s",$tmp[0]);
}
return (@output);
}
# ExistResourceInCDB
# Returns 1 if the resource exists, else -1 if it dosesn't.
#
sub ExistResourceInCDB {
local ($machine, $restype) = @_;
local ($Output, $cmd,$line,$pos);
local ($flag) = 0;
$cmd="$CLI_PATH/restypeEnumerate _CLUSTER=$Cluster";
@output=&rsh($machine,$cmd);
if ($RSH_ERRNO != 0) {
return $NULL;
}
$restype=~s/\"//g; # Remove any quotes
$pos=-1;
foreach $line (@output) {
if (($pos=strstr($line,$restype)) > -1) {
$flag=1;
}
}
return $flag;
}
# PrefixifyMultiLineString
# Adds a user defines prefix to the $string. Returns the modified string
#
sub PrefixifyMultiLineString
{
local($prefix,$string) = @_;
local($ending_nl,$new_string,$line,@lines);
$ending_nl = (substr($string,length($string) - 1,1) eq "\n");
if ($ending_nl) { chop($string); }
$new_string = "";
@lines = split("\n",$string . "\n*");
pop(@lines);
foreach $line (@lines)
{
$new_string = $new_string . $prefix . $line . "\n";
}
if (! $ending_nl) { chop($new_string); }
return($new_string);
}
# CheckProc
# Returns 1 if the process exists on machine, else 0;
#
sub CheckProc {
local ($machine, $proc) = @_;
local ($cmd, @output, $linem, $found, $pos);
$cmd="/sbin/ps -e | grep $proc";
@output=&rsh($machine,$cmd,);
if ($RSH_ERRNO != 0) {
return $NULL;
}
$pos=1;
$found=0;
foreach $line (@output) {
if ( ($pos=strstr($type,$res)) > -1) {
$found=1;
}
}
return $found;
}
# GetMachineInfo
# Returns the machine parameters for a machine.
#
sub GetMachineInfo {
local ($machine) = @_;
local (@output, $cmd);
$cmd="$CLI_PATH/machineQuery _NUM_MACHINES=1 _MACHINE_0=$machine";
@output=&do_cmd_with_timeout($cmd,10);
return @output;
}
# GetMachineParam
# Returns the value of a machine parameter.
#
sub GetMachineParam {
local ($str, @list) = @_;
local ($key, $val);
local ($line);
foreach $line (@list) {
($key, $val)=split(": ",$line);
$key=substr($key,0,length($str));
if ( $key eq $str ) {
# found the string line
return $val;
}
}
return -1;
}
# The rest of these fuctions have been taken from Array Services
# Perl library.
#
sub get_ip_address {
local ($nxt_host, $timeout) = @_;
local ($h_name, $h_aliases, $h_addrtype, $h_len, @h_addrs);
local ($this_cmd, $first, $second, $third, $fourth, $old_sig);
# so that handler can kill it.
$this_cmd = "gethostbyname ($nxt_host)";
# Can not use subroutine <do_cmd_with_timeout> since that is
# for system calls etc. Will just do the timeout here itself.
$old_sig = $SIG{'ALRM'};
$SIG{'ALRM'} = 'lanarray_alrm_handler';
# Enable timeout.
alarm ($timeout);
($h_name,$h_aliases,$h_addrtype,$h_len,@h_addrs)=gethostbyname($nxt_host);
# Disable timeout.
alarm (0);
$SIG{'ALRM'} = $old_sig;
if (@h_addrs) {
# Got at least one IP address. Read the first one.
if (scalar(@h_addrs)) {
&Verbose("Number of IP addresses obtained for <%s> = %s",
$nxt_host,scalar(@h_addrs));
}
($first, $second, $third, $fourth) = unpack('C4', $h_addrs[0]);
$ip_address{$nxt_host}=$first.".".$second.".".$third.".".$fourth;
if ($ip_address{$nxt_host}) {
&Verbose("\tThe first IP address for <%s> = %s",
$nxt_host, $ip_address{$nxt_host});
}
}else{
# IP address(es) not filled in. Error.
&Error(0,"Can't Find IP Address For Node '$nxt_host'\n");
&Suggest("(1) Check /etc/resolv.conf (see 'man resolv.conf')\n" .
"(2) Verify Host Tables, If Using\n" .
"(3) Verify NIS, If Using\n" .
"(4) Verify BIND, If Using\n");
return $CD_FAILURE;
}
return $CD_SUCCESS;
}
####################################################################
# SUBROUTINE PING_HOST_CHECK #
# Check to see if the host given is pingable. #
####################################################################
sub ping_host_check {
local ($machine, $remote_host, $timeout) = @_;
local ($ping_cmd, @ping_out);
local ($found)=0;
$ping_cmd = "/usr/bsd/rsh $machine -n /usr/etc/ping -c1 $remote_host";
@ping_out = &do_cmd_with_timeout($ping_cmd, $timeout);
if (scalar(@ping_out) > 1) {
foreach $line (@ping_out) {
if ($line =~/.*100.*.packet loss.*/) {
$found=1;
}
}
}
if (($found) || (scalar(@ping_out) < 1)) {
&Error(0,"Ping Failed To Node '%s'\n",$remote_host);
&Suggest("(1) Ensure Node '$remote_host' Is Up\n" .
"(2) Ensure Node '$remote_host' Can ping Itself\n" .
"(3) Ensure Node '$remote_host' Connected To Network");
return 0;
}
return 1;
} # end of "sub ping_host_check"
####################################################################
# SUBROUTINE OTHERS_RSH_CHECK #
# Check to see if I can guest rsh to the host given. #
# (use command "date"). #
####################################################################
sub others_rsh_check {
local ($remote_host, $timeout) = @_;
local ($rsh_cmd, $rsh_out);
$rsh_cmd = "/usr/bsd/rsh $remote_host -l guest -n date";
$rsh_out = &do_cmd_with_timeout($rsh_cmd, $timeout);
if ($? == 0) {
if ($Verbose) {
print "Output from rsh:\n$rsh_out\n";
print "Successful in guest rsh'ing to <$remote_host>.\n\n";
}
&Notice("Successful 'guest rsh' To '$remote_host'\n");
}
else {
# $? != 0; rsh failed.
&lan_warning_msg_print;
if ($Verbose) {
&Warning("Unable to rsh to <$remote_host> as guest.\nRsh failed with output:\n$rsh_out\n");
}
&Warning("Cannot Perform 'guest rsh' To Node '$remote_host'\n");
&Suggest("Fix 'guest rsh' Unless Intentionally Restricted\n");
}
} # end of "sub others_rsh_check"
####################################################################
# SUBROUTINE TTCP_ALL_CHECK #
# Test ttcp between local and given remote machine for the primary #
# interface. #
####################################################################
sub ttcp_all_check {
local ($remote_host, $timeout) = @_;
local ($ip_name, $ttcp_options, $arbit_num, $fourth, $port_num);
#FIX: test all network interfaces other than hippi?
#################################################################
# Primary interface test. Use non-default values for portnum, #
# length of buffer etc. ttcp_check args: #
# remote hostname, #
# ip_name (same as above), #
# timeout, #
# expected perf (KB/s) - 500 KB/s #
# other ttcp options (if non-default) - -p port -n 1024 #
#################################################################
$ip_name = $remote_host;
#################################################################
# Need a "unique" port number for this ttcp session to send/ #
# listen to. Make it equal to 5001 + fourth field of ip address #
# + $$ (or modulo, if $$ > 10000). #
#################################################################
if ($ip_address{$remote_host} =~ /\d+\.\d+\.\d+\.(\d+)/ ) {
$fourth = $1;
}
else {
&lan_error_msg_print;
&InternalError(__LINE__,__FILE__,"Unexpected IP Address Format.\n");
}
$arbit_num = $$;
if ($arbit_num > 10000) {
$arbit_num = ($arbit_num)%10000;
}
$port_num = 5001 + $fourth + $arbit_num;
$ttcp_options = " -p $port_num -n 1024";
&ttcp_check($remote_host, $ip_name, $timeout, 500, $ttcp_options);
} # end of "sub ttcp_all_check"
####################################################################
# SUBROUTINE TTCP_CHECK #
# Test ttcp between local and given remote ip_name. #
####################################################################
sub ttcp_check {
local ($remote_host, $ip_name, $timeout, $exp_perf, $ttcp_options) = @_;
local ($ttcp_cmd_string, $ttcp_dest_cmd, $ttcp_dest_out, $ttcp_file);
local ($ttcp_src_cmd, $ttcp_src_out, $thruput_number, $file_out);
local ($ttcp_recv_ready, $ttcp_rcvr_pid, $user_name, $port_option);
$user_name = (getpwuid($>))[0];
# The file to store the output and error from ttcp-rcver.
$ttcp_file = "/usr/tmp/lantest$$_0";
#################################################################
# The essential steps: #
# (i) Start ttcp in receive mode at the remote end in bg. #
# (rsh remote_host '/bin/sh -c \"/usr/etc/ttcp -r -s #
# 1>ttcp_file 2>&1 & \"') etc #
# /bin/sh because of user's default shell being csh etc... #
#(ii) Start ttcp in transmit mode at this end. #
# (/usr/etc/ttcp -t -s remote_host) etc #
#################################################################
# The basic ttcp string with its options.
$ttcp_cmd_string = "/usr/etc/ttcp -s";
# Now add the options passed in.
$ttcp_cmd_string = $ttcp_cmd_string . $ttcp_options;
#################################################################
# Redirect the output of ttcp to $ttcp_file on remote host. #
# Will look at the file to make sure the ttcp-rcver is set up #
# before starting the ttcp-tmitter. Also this file will contain #
# error msgs, if ttcp failed on the receiver end. #
#################################################################
$ttcp_dest_cmd = "/usr/bsd/rsh $remote_host -n '/bin/sh -c \"$ttcp_cmd_string -r 1>$ttcp_file 2>&1 & \"'";
$ttcp_dest_out = &do_cmd_with_timeout($ttcp_dest_cmd, $timeout);
if (($? != 0) || ($ttcp_dest_out)) {
&lan_error_msg_print;
&Error(1,"Remote Shell On '$remote_host' Failed With Output:\n$ttcp_dest_out\n");
}
# Check to see if ttcp is running on remote host. Look for this port no.
if ($ttcp_options =~ /(-p\s+\d+)\s*/) {
$port_option = $1;
}
else {
$port_option = '';
}
$ttcp_rcvr_pid =
&remote_ttcp_process($remote_host, $user_name, $timeout, $port_option);
if (!$ttcp_rcvr_pid) {
# Our ttcp not running on remote node. Error.
&lan_error_msg_print;
# Check the file for error msg.
&Error(0,"Receiver 'ttcp' Process Not Running On '$remote_host'\n");
$file_out = &get_remote_file ($remote_host, $ttcp_file, $timeout);
if ($file_out !~ /^UX:cat:\s*ERROR:/) {
# File exists. Clean it up before dying.
&Error(0,"The Output From 'ttcp' Was:\n$file_out\n");
&clean_up_ttcp_file ($remote_host, $timeout, $ttcp_file);
}
&ExitGracefully(1);
}
#################################################################
# ttcp-r running. Check ttcp_file to make sure it is indeed our #
# ttcp-r (the one that we just tried to start) & has opened a #
# socket etc. Try to get that file 10 (???) times with a sec #
# interval between each get. Error if cannot access file. #
#################################################################
$ttcp_recv_ready = 0;
for (1 .. 10) {
$file_out = &get_remote_file ($remote_host, $ttcp_file, $timeout);
if ($file_out !~ /^UX:cat:\s*ERROR:/) {
###########################################################
# File exists. Check its contents. If there was some error#
# in starting the ttcp recieiver, the error msg will be #
# in this file and it will have the "errno" keyword set. #
# And you got here becoz ANOTHER ttcp process was running #
# under your user id. If this file does not have an error #
# condition keyword and if our ttcp-recvr process is run- #
# ning, this file should have a line with "socket" in it. #
###########################################################
if ($file_out =~ /errno/) {
&Error(0, "Receiver 'ttcp' Process Not Running On '$remote_host'\n");
&Error(0,"The Output From 'ttcp' Was:\n$file_out\n");
&clean_up_ttcp_file ($remote_host, $timeout, $ttcp_file);
&ExitGracefully(1);
}
elsif ($file_out =~ /socket/) {
$ttcp_recv_ready = 1;
last;
}
}
sleep (1);
} # for (1 .. 10)
if ($ttcp_recv_ready == 0) {
# Die after cleaning up ttcp-r and ttcp_file on the remote host.
&clean_up_ttcp_recvr ($remote_host, $timeout, $ttcp_pid);
&clean_up_ttcp_file ($remote_host, $timeout, $ttcp_file);
&lan_error_msg_print;
&Error(1,"Time Out Starting Receiver 'ttcp'\n");
}
$ttcp_timeout = 30; # Shouldn't this be even greater than 30?
$ttcp_src_cmd = "$ttcp_cmd_string -t $ip_name";
$ttcp_src_out = &do_cmd_with_timeout($ttcp_src_cmd, $ttcp_timeout);
if ($? == 0) {
# Get the thruput number out from the 5th line.
if ($ttcp_src_out =~ m&=\s+(\d+\.\d+)\s+KB/sec&) {
$thruput_number = $1;
&Notice("Bandwidth To '$ip_name' = %.1f KB/sec\n",
$thruput_number);
if ($thruput_number < $exp_perf) {
&lan_warning_msg_print;
&Warning("Obtaining Less Than %.1f KB/sec To '%s'\n",
$exp_perf,$ip_name);
}
}
else {
&InternalError(__LINE__,__FILE__, "Unexpected Output From ttcp.\n");
}
&clean_up_ttcp_file ($remote_host, $timeout, $ttcp_file);
}
else {
&clean_up_ttcp_file ($remote_host, $timeout, $ttcp_file);
&lan_error_msg_print;
&Error(1,"Program 'ttcp' Failed: $ttcp_src_out\n");
}
} # end of "sub ttcp_check"
####################################################################
# SUBROUTINE REMOTE_TTCP_PROCESS #
# Checks to see if there is a ttcp process with the given options #
# is running on the remote host. #
# Return value = pid if yes, #
# = 0 if not. #
####################################################################
sub remote_ttcp_process {
local ($remote_host, $myid, $timeout, $ttcp_options) = @_;
local ($ttcp_ps_cmd, $ttcp_ps_out, @ttcp_ps_list, $ttcp_ps_line);
local ($ttcp_pid, @ttcp_fields);
$ttcp_ps_cmd = "/usr/bsd/rsh $remote_host -n /sbin/ps -ef";
$ttcp_ps_out = &do_cmd_with_timeout ($ttcp_ps_cmd, $timeout);
if ($? == 0) {
@ttcp_ps_list = grep((/ttcp/ && !/grep\s*ttcp/ && /$ttcp_options/),
split(/\n/, $ttcp_ps_out));
if (@ttcp_ps_list) {
$ttcp_pid = 0;
# ttcp is running on remote host.
foreach $ttcp_ps_line (@ttcp_ps_list) {
# If this is for your user id, get the pid.
@ttcp_fields = split (' ', $ttcp_ps_line);
if ($ttcp_fields[0] eq $myid) {
$ttcp_pid = $ttcp_fields[1];
last;
}
}
return($ttcp_pid);
}
else {
return(0);
}
}
else {
&lan_error_msg_print;
&Error(1,"Remote Command '$ttcp_ps_cmd' Failed With Output:\n$ttcp_ps_out");
}
} # end of "sub remote_ttcp_process"
####################################################################
# SUBROUTINE CLEAN_UP_TTCP_RECVR #
####################################################################
sub clean_up_ttcp_recvr {
local ($remote_host, $timeout, $ttcp_pid) = @_;
local ($kill_cmd, $kill_out);
# print "Cleaning up the ttcp-r process created for ttcp test.\n";
$kill_cmd = "/usr/bsd/rsh $remote_host -n /usr/bin/kill $ttcp_pid";
$kill_out = &do_cmd_with_timeout ($kill_cmd, $timeout);
if ($? != 0) {
&lan_error_msg_print;
&Error(1,"Remote Command '$kill_cmd' Failed With Output:\n$kill_out");
}
} # end of "sub clean_up_ttcp_recvr"
####################################################################
# SUBROUTINE CLEAN_UP_TTCP_FILE #
####################################################################
sub clean_up_ttcp_file {
local ($remote_host, $timeout, $ttcp_file) = @_;
local ($rm_cmd, $rm_out);
# &Notice ("Deleting Temp File '$ttcp_file'\n");
$rm_cmd = "/usr/bsd/rsh $remote_host -n /sbin/rm $ttcp_file";
$rm_out = &do_cmd_with_timeout ($rm_cmd, $timeout);
if ($? != 0) {
&lan_error_msg_print;
&Error(1,"Remote Command '$rm_cmd' Failed With Output:\n$rm_out");
}
} # end of "sub clean_up_ttcp_file"
####################################################################
# SUBROUTINE MALLICK_CHECK #
# Check whether on the given host: (as per Mallick) #
# (i) nfs is installed, #
# (ii) network, nfs & automount/autofs/amd chkcfg'ed to <on>, #
# (iii) automounter/autofs/amd is running on the remote host, #
# (iv) /etc/exports has at least one line in it, and #
# (v) can cd to /hosts/$remote_host/{dirs mounted} #
# Added amd as automounter alternative (NASA Ames) - 10/19/95 #
# Added autofs as automounter alternative - 03/13/96, IP #
####################################################################
sub mallick_check {
local ($remote_host, $timeout) = @_;
local ($remote_automounter);
# Do a versions on nfs.
&nfs_check($remote_host, $timeout);
# Test chkconfig flags for network, nfs and automount/autofs/amd.
$remote_automounter = &chkcfg_check($remote_host, $timeout);
&Notice("Host '$remote_host' is using automounter '$remote_automounter'\n");
# Test whether automounter running or not.
&automounter_check($remote_host, $remote_automounter, $timeout);
# Get /etc/exports from given host & test cd'ing to its first exp. dir.
&exports_check($remote_host, $remote_automounter, $timeout);
} # end of "sub mallick_check"
#####################################################################
# SUBROUTINE NFS_CHECK #
# Check whether NFS installed on the remote host. #
#####################################################################
sub nfs_check {
local ($remote_host, $timeout) = @_;
local ($versions_cmd, $versions_out, @nfs_lines);
# Do a versions on nfs.
&Notice("Checking nfs Version On '$remote_host'\n");
$versions_cmd = "/usr/bsd/rsh $remote_host -n /usr/sbin/versions nfs";
$versions_out = &do_cmd_with_timeout ($versions_cmd, $timeout);
if ($? == 0) {
# Check if any nfs lines.
@nfs_lines = grep (/nfs/, split(/\n/, $versions_out));
if (@nfs_lines) {
# Check for no 'R' in the first column (first letter?) of each line.
foreach (@nfs_lines) {
if (/^\s*R/) {
&lan_error_msg_print;
&Error(0,"NFS Removed From '$remote_host'\n");
if ($Verbose)
{
&Error(0,"Output of versions:\n@nfs_lines\nQuitting ...\n");
}
&ExitGracefully(1);
}
}
# Here because no 'R' in first column.
if ($Verbose) { &Notice("Output from versions:\n@nfs_lines\n"); }
&Notice("NFS Installed On '$remote_host'\n");
}
else {
&lan_error_msg_print;
&Error(1,"NFS Not Installed On '$remote_host'\n");
}
}
else {
# $? != 0; rsh failed.
&lan_error_msg_print;
if ($Verbose) { &Error(0,"Rsh failed with output:\n$versions_out\n"); }
&Error(1,"Couldn't Run '$versions_cmd'\n");
}
} # end of "sub nfs_check"
#####################################################################
# SUBROUTINE CHKCFG_CHECK #
# Check the config. status of the network, nfs & automounter flags #
# on a remote machine and return the automounter in use there. #
#####################################################################
sub chkcfg_check {
local ($remote_host, $timeout) = @_;
local ($flag, $chk_cmd, $chk_out, @chk_lines, @chk_fields);
local ($num_flags_correct, $key_field, $val_field);
local ($remote_automounter);
# Do a chkconfig.
&Notice("Verifying NFS Configuration Flags\n");
$num_flags_correct = 0;
$chk_cmd = "/usr/bsd/rsh $remote_host -n /sbin/chkconfig";
$chk_out = &do_cmd_with_timeout($chk_cmd, $timeout);
if ($? == 0) {
# Grep out the lines with nfs and network.
foreach $flag ("network", "nfs")
{
@chk_lines = grep (/$flag\s+\S+/, split(/\n/, $chk_out));
if (@chk_lines < 1)
{
&Error(0,"Configuration Flag '$flag' Not Set For '$remote_host'\n");
&Suggest("Do 'chkconfig $flag on' For '$remote_host'\n");
next;
}
elsif (@chk_lines > 1)
{
&Warning("Multiple '$flag' Flags From 'chkconfig' For '$remote_host'\n");
}
($key_field, $val_field) = ($chk_lines[0] =~ /\s*(\S+)\s+(\S+)/);
if ($val_field eq 'on')
{
if ($Verbose) { &Notice("Flag '$key_field' Correctly Configured 'on' For '$remote_host'\n"); }
++ $num_flags_correct;
}
elsif ($val_field eq 'off')
{
&lan_error_msg_print;
&Error(0,"Flag '$key_field' Incorrectly Configured 'off' For '$remote_host'\n");
&Suggest("Do 'chkconfig $key_field on'\n");
}
elsif ($val_field eq '')
{
&lan_error_msg_print;
&Error(0,"Flag '$key_field' Not Set For '$remote_host'\n");
&Suggest("Do 'chkconfig $key_field on'\n");
}
else
{
&lan_error_msg_print;
&Error(0,"Flag '$key_field' Has Bogus State '$val_field' For '$remote_host'\n");
&Suggest("Do 'chkconfig $key_field on'\n");
}
}
# Make sure at least one automounter is available
$remote_automounter = "";
foreach $flag ("automount", "autofs", "amd")
{
@chk_lines = grep (/$flag\s+\S+/, split(/\n/, $chk_out));
if (@chk_lines < 1)
{
next;
}
elsif (@chk_lines > 1)
{
&Warning("Multiple '$flag' Flags From 'chkconfig' For '$remote_host'\n");
}
($key_field, $val_field) = ($chk_lines[0] =~ /\s*(\S+)\s+(\S+)/);
if ($val_field eq 'on')
{
if ($Verbose) {
&Notice("Flag '$key_field' Configured 'on' For '$remote_host'\n");
}
$remote_automounter = $key_field;
++$num_flags_correct;
last;
}
elsif ($Verbose) {
&Notice("Flag '$key_field' Is Not Configured 'on' For '$remote_host'\n");
}
}
if ("$remote_automounter" eq "") {
&Error(0, "No Automounter Installed On '$remote_host'\n");
&Suggest("Do 'chkconfig autofs on' or 'chkconfig automount on'\n");
}
# Summarize our results
if ($num_flags_correct == 3)
{
&Notice("Network/NFS Configuration Flags Are Correct For '$remote_host'\n");
}
else
{
&Error(0,"Only %d Of 3 Network/NFS Configuration Flags Are Correct For '$remote_host'\n",
$num_flags_correct);
&Suggest("Follow Suggestions Above\n");
&ExitGracefully(1);
}
} # if ($? == 0)
else
{
# $? != 0; rsh failed.
&lan_error_msg_print;
if ($Verbose)
{
&Error(0,"Rsh failed with output:\n$chk_out\nQuitting ...\n");
}
&Error(1,"Couldn't Run '$chk_cmd'\n");
}
return $remote_automounter;
} # end of "sub chkcfg_check"
#####################################################################
# SUBROUTINE AUTOMOUNTER_CHECK #
# Check to see if automount running on remote host. #
#####################################################################
sub automounter_check {
local ($remote_host, $automounter, $timeout) = @_;
local ($ps_cmd, $ps_out, @ps_lines);
&Notice("Ensuring '$automounter' Operational On '$remote_host'\n");
$ps_cmd = "/usr/bsd/rsh $remote_host -n /sbin/ps -ef";
$ps_out = &do_cmd_with_timeout ($ps_cmd, $timeout);
if ($? == 0) {
# Grep for automount.
@ps_lines = grep ((/$remote_automounter/ && !/grep\s*$remote_automounter/),
split(/\n/, $ps_out));
if (@ps_lines) {
&Notice("Automounter Running On '$remote_host'\n");
}
else {
&lan_error_msg_print;
&Error(1,"Automounter Not Running On '$remote_host'\n");
}
}
else {
# $? != 0; rsh failed.
&lan_error_msg_print;
&Error(1,"Remote Command '$ps_cmd' Failed With Output:\n$ps_out");
}
} # end of "sub automounter_check"
#####################################################################
# SUBROUTINE EXPORTS_CHECK #
# Test cd'ing to /hosts/$remote_host and examining <etc/exports>. #
#####################################################################
sub exports_check {
local ($remote_host, $automounter, $timeout) = @_;
local ($cat_cmd, $cat_out, @cat_lines, $nxt_line, $dir_name);
local ($all_lines_good, $found_line, $exp_dir, $this_dir);
# First, get the contents of the /etc/exports file from remote host.
$cat_cmd = "/usr/bsd/rsh $remote_host -n /sbin/cat -u /etc/exports";
$cat_out = &do_cmd_with_timeout ($cat_cmd, $timeout);
if ($? == 0) {
###############################################################
# Rsh successful, check to see if cat was successful by #
# examining the first line from cat_out for an ERROR line. #
# If ERROR appears, then error in reading /etc/exports. #
# (If error, the output looks like one of #
# UX:cat: ERROR: Cannot open mine: No such file or directory #
# UX:cat: ERROR: Cannot open /mine: Permission denied ... #
# So look for /^\s*UX:cat:\s*ERROR:/ in the first line.) #
###############################################################
@cat_lines = split (/\n/, $cat_out);
if ($cat_lines[0] =~ /^\s*UX:cat:\s*ERROR:/) {
&lan_warning_msg_print;
&Warning("Command 'cat /etc/exports' Failed On '$remote_host'\n");
if ($cat_out =~ /No such file/) {
&Warning("File '/etc/exports' Does Not Exist On '$remote_host'\n");
}
elsif ($cat_out =~ /Permission denied/) {
&Warning("File '/etc/exports' On '$remote_host' Is Not Readable By You\n");
}
}
else {
###########################################################
# Cat was successful. #
# Look for atleast one uncommented line, and then try to #
# cd to it. (Ex. if line is '/', then the corresponding #
# dir is /hosts/$remote_host/). If unable to, then warn. #
###########################################################
$found_line = 0;
$all_lines_good = 1;
$this_dir = `pwd`; # So I can come back to it.
chop($this_dir);
foreach $nxt_line (@cat_lines) {
if ($nxt_line !~ /^\s*#/) {
if ($found_line == 0) {
$found_line = 1;
}
# The first field is the exported directory.
$exp_dir = (split(' ', $nxt_line))[0];
#####################################################
# If automount/fs being used,check /hosts/<host>/...#
# If amd being used, check /r/<host>/... #
#####################################################
if (($automounter eq "automount") ||
($automounter eq "autofs")) {
$dir_name = "/hosts/$remote_host$exp_dir";
}
else {
$dir_name = "/r/$remote_host$exp_dir";
}
if (!(-e $dir_name)) {
&lan_warning_msg_print;
$all_lines_good = 0;
&Error(0,"NFS Directory '%s' in '%s:%s' Doesn't Exist\n",
$dir_name,$remote_host,"/etc/exports");
}
elsif (chdir "$dir_name") {
# Now, chdir back to original place.
chdir "$this_dir" ||
&InternalError(__LINE__,__FILE__,
"Unable to cd to '$this_dir': $!\n");
}
else {
&lan_warning_msg_print;
$all_lines_good = 0;
&Error(0,"Can't 'cd' To NFS Directory '%s' in '%s:%s'\n",
$dir_name,$remote_host,"/etc/exports");
}
}
}
if ($found_line) {
if ($all_lines_good) {
&Notice("Entries In '%s:%s' Pass Verification\n",
$remote_host,"/etc/exports");
}
else {
&Error(0,"Some Nodes Export Unreachable NFS Directories\n");
#FIX: put suggestions here
&ExitGracefully(1);
}
}
else {
&lan_warning_msg_print;
&Notice("Node '$remote_host' NFS Exports No Directories\n");
}
} # else (cat succeeded)
} # if ($? = 0)
else { #$? != 0
&lan_error_msg_print;
&Error(1,"Remote Command '$cat_cmd' Failed With Output:\n$cat_out");
}
} # end of "sub exports_check"
####################################################################
# SUBROUTINE LAN_ERROR_MSG_PRINT #
####################################################################
sub lan_error_msg_print {
if ($Verbose)
{
print STDERR <<'LAN_ERRMSG';
ERROR ERROR ERROR ERROR ERROR ERROR ERROR ERROR ERROR ERROR ERROR ERROR
ERROR ERROR
ERROR *** LAN NODE DIAGNOSTICS FAILED *** ERROR
ERROR ERROR
ERROR ERROR ERROR ERROR ERROR ERROR ERROR ERROR ERROR ERROR ERROR ERROR
LAN_ERRMSG
}
} # end of "lan_error_msg_print"
####################################################################
# SUBROUTINE LAN_WARNING_MSG_PRINT #
####################################################################
sub lan_warning_msg_print {
local($warning_msg) = @_;
local ($ans);
print <<"LAN_WARNMSG";
*** WARNING FROM CONNECTIVITY TESTS ***\n
$warning_msg;
LAN_WARNMSG
print "Continue Y/N ";
chop ($ans = <STDIN>);
if ($ans eq Y) {
return (1);
}
else {
return (0);
}
}
# end of "lan_warning_msg_print"
#=============================================================================
#
# RunCommandsWithTimeout(timeout,commands...)
#
# This routine simultaneously spawns a bunch of commands, and sets
# a timeout for all of them. The program returns the count of
# commands which did not return before the timeout expired, and a list
# of filenames:return-status, one corresponding to each command in the
# list, which contains the output for each command. If the command
# timed out, the filename is the empty string. The program return
# status follows the filename, and is separated by a colon. The caller
# is responsible for deleting the temporary file.
#
# Subroutines: SpawnCommand, TimeoutHandler
# Global variables: %DONE, $SIG{'ALRM'}
#
#=============================================================================
#sub RunCommandsWithTimeout
#{
# local($timeout,@commands) = @_;
# local($command,$timed_out,$num_spawned,$num_done,$index,$old_sig);
# local($child_pid,$out_file,$num_spawned,$dead_pid,$dead_status);
# local($i,$done,$num_drowzy,$str);
# local(@output_files);
# local(%PIDS,%MACHINES,%COMMANDS,%OUTFILES,%STATUS);
# $timed_out = 0;
##
## Spawn Commands
##
# $num_spawned = 0;
# $num_done = 0;
# $index = 0;
# foreach $command (@commands)
# {
# ($child_pid,$out_file) = &SpawnCommand($command);
# if ($child_pid > 0)
# {
# $PIDS{$index++} = $child_pid;
# $COMMANDS{$child_pid} = $command;
# $OUTFILES{$child_pid} = $out_file;
# $STATUS{$child_pid} = -1;
# $DONE{$child_pid} = 0;
# ++ $num_spawned;
# }
# }
##
## Set Up Timeout
##
# $old_sig = $SIG{'ALRM'};
# $SIG{'ALRM'} = 'TimeoutHandler';
# alarm($timeout);
##
## Wait For Jobs To Finish or Timeout
##
# while (1)
# {
# $dead_pid = wait;
# $dead_status = ($? >> 8);
# if ($dead_pid != -1)
# {
# if ($DONE{$dead_pid} == 0)
# {
# $DONE{$dead_pid} = 1;
# $STATUS{$dead_pid} = $dead_status;
# ++ $num_done;
# }
# }
# if ($num_done == $num_spawned)
# {
# last;
# }
# if ($timed_out)
# {
# last;
# }
# }
##
## Disable Timeout
##
# alarm(0);
# $SIG{'ALRM'} = $old_sig;
##
## Collect Results
##
# @output_files = ();
# for ($i = 0; $i < $index; $i++)
# {
# $child_pid = $PIDS{$i};
# $done = $DONE{$child_pid};
# if ($done == 1)
# {
# $str = sprintf("%s:%d",$OUTFILES{$child_pid},
# $STATUS{$child_pid});
# }
# else
# {
# $str = sprintf("%s:%d","",$STATUS{$child_pid});
# unlink($OUTFILES{$child_pid});
# }
# push(@output_files,$str);
# }
# $num_drowzy = ($num_spawned - $num_done);
# return($num_drowzy,@output_files);
#}
##=============================================================================
##
## OSVersion()
##
## This routine returns the IRIX version number as a numeric value,
## or "0" if it cannot be determined. "Sub-minor" numbers (e.g. the
## ".1" in "6.4.1") are ignored.
##
##=============================================================================
#sub OSVersion
#{
# local ($uname_out, $OSVer);
# $uname_out = `/sbin/uname -r`;
# chop($uname_out);
# if ($uname_out =~ /^(\d+\.\d+)/) {
# $OSVer = $1;
# }
# else {
# &Warning("Unable to determine OS version\n");
# $OSVer = 0;
# }
# return($OSVer);
#}
##=============================================================================
##
## GetIPByDeviceName(device_name,[remote_host])
##
## This routine returns a hostname and a dotted string representation of
## associated IP address for a device named <device_name> on the local
## host, or if <remote_host> is set, on that host.
##
## The routine returns a triple (<hostname>,<hostaddr>,<upness>) that
## indicates the hostname of the interface, the IP address of the interface
## in "dotted string" notation, and a boolean indicating whether the
## interface is currently up.
##
##=============================================================================
#sub GetIPByDeviceName
#{
# local($device_name,$remote_host) = @_;
# local($log,@result);
# $log = &DoNetstat($remote_host);
# @result = &GetIPByDeviceNameAndNetstatFile($device_name,$log);
# unlink($log);
# return(@result);
#}
##=============================================================================
##
## DoNetstat([remote_host])
##
## This routine returns the filename of a local file that contains the
## netstat lines from netstat run on the local host, or on <remote_host>
## if defined.
##
##=============================================================================
#sub DoNetstat
#{
# local($remote_host) = @_;
# local($log,@result);
# if ($remote_host eq "")
# {
# @result = &RunCommandsWithTimeout(10,"/usr/etc/netstat -in");
# }
# else
# {
# @result = &RunCommandsWithTimeout(10,
# "/usr/bsd/rsh $remote_host -n /usr/etc/netstat -in");
# }
# if ($result[0] != 0)
# {
# &Error(1,"Timeout Of '/usr/etc/netstat -in'\n");
# }
# $log = (split(':',$result[1]))[0];
# return($log);
#}
#=============================================================================
#
# GetNetworkInterfaces([remote_host])
#
# This function gets the network interfaces on the local host,
# or on the host <remote_host> if defined, and returns a list of
# strings, one string per interface.
#
# Each string is composed of "<ifname>:<hostname>:<ipaddr>:<up>"
#
#=============================================================================
#sub GetNetworkInterfaces
#{
# local($remote_host) = @_;
# local($file,$pattern,$line,@result,$if,$hn,$ip,$up,@interfaces);
# $file = &DoNetstat($remote_host);
# open(INGNI,$file) || &Error(1,"Can't Open '$file'\n");
# $pattern = "^([^ \\*]+)([ \\*])\\s*\\S+\\s+(\\S+)\\s+(\\S+)\\s+";
# while ($line = <INGNI>)
# {
# chop($line);
# @result = ($line =~ $pattern);
# if (@result != 4) { next; }
# if ($result[0] eq "Name") { next; }
# $if = $result[0];
# $ip = $result[3];
# $up = ($result[1] ne "*");
# $hn = &IPAddressToHostname($ip);
# push(@interfaces,"$if:$hn:$ip:$up");
# }
# close(INGNI);
# return(@interfaces);
#}
##=============================================================================
##
## GetIPByDeviceNameAndNetstatFile(device_name,file)
##
## This is a low-level helper routine for GetIPByDeviceName. It takes
## a file name <file>, produced by 'netstat -in', and searches it for
## the device <device_name>.
##
## The routine returns a hostname and a dotted string representation of
## the associated IP address for a device named <device_name>. The
## routine returns a triple (<hostname>,<hostaddr>,<upness>) that
## indicates the hostname of the interface, the IP address of the
## interface in "dotted string" notation, and a boolean indicating
## whether the interface is currently up.
##
##=============================================================================
#sub GetIPByDeviceNameAndNetstatFile
#{
# local($device_name,$file) = @_;
# local($line,$ip,$hostname,$up);
# local(@result);
# open(INGIBD,$file) || &Error(1,"Can't Open '$file'\n");
# $pattern = "^([^ \\*]+)([ \\*])\\s*\\S+\\s+(\\S+)\\s+(\\S+)\\s+";
# while ($line = <INGIBD>)
# {
# @result = ($line =~ $pattern);
# if (@result != 4) { next; }
# if ($result[0] ne $device_name) { next; }
# $up = ($result[1] ne "*");
# $ip = $result[3];
# $hostname = &IPAddressToHostname($ip);
# close(GIBD);
# return($hostname,$ip,$up);
# }
# close(GIBD);
# return();
#}
##=============================================================================
##
## SelectBestInterface([remote_host])
##
## This routine returns the interface name of the "best" network
## interface on the local machine, or on the host <remote_host>
## if defined. The definition of "best" is a judgement call based
## on factors like throughput and latency, and is encapsulated in
## the array "InterfacesByQuality".
##
## If the global variable "FastIF" has a value, it is always
## returned as the "best" interface if it exists.
##
## The result is returned in the form "<ifname>:<hostname>:<ipaddr>",
## or an empty string if no interfaces are recognized.
##
##=============================================================================
#sub SelectBestInterface
#{
# local($remote_host) = @_;
# local(@InterfacesByQuality,@interfaces,@result);
# local($best,$bestquality,$currpatt);
# local($entry,$if,$hn,$ip,$up,$curr,$currquality);
# @InterfacesByQuality = ("hip[0-9]+",
# "xpi[0-9]+",
# "ipg[0-9]+",
# "ef[0-9]+",
# "fxp[0-9]+",
# "et[0-9]+",
# "ec[0-9]+",
# "lo0");
# @interfaces = &GetNetworkInterfaces($remote_host);
# $best = "";
# $bestquality = 999;
# foreach $entry (@interfaces)
# {
# @result = split(":",$entry);
# if (@result != 4)
# {
# next;
# }
# ($if,$hn,$ip,$up) = @result;
# if (! $up) {
# next;
# }
# $curr = "$if:$hn:$ip";
# if ($if eq $FastIF) {
# return($curr);
# }
# $currquality = 0;
# foreach $currpatt (@InterfacesByQuality)
# {
# last if $if =~ /$currpatt/;
# ++$currquality;
# }
# if ($currquality >= @InterfacesByQuality) {
# &Warning("Don't know about interface type '$if'\n");
# }
# if ($currquality < $bestquality) {
# $best = $curr;
# $bestquality = $currquality;
# }
# }
# return($best);
#}
##=============================================================================
##
## GetArrayMachines([array])
##
## This routine returns the list of machines comprising the array
## named <array>, or the default array if unspecified.
##
##=============================================================================
#sub GetArrayMachines
#{
# local($array) = @_;
# local($log,$options,$cmd,$line,$host,@result,@machines);
# if ($array ne "") { $options = "-a $array"; }
# $cmd = "ainfo -f 3 $options machines";
# @result = &RunCommandsWithTimeout(10,$cmd);
# if ($result[0] != 0) { &Error(1,"Timeout Of '$cmd'\n"); }
# $log = (split(':',$result[1]))[0];
# open(INGAM,$log) || &Error(1,"Can't Open File '$log'\n");
# while ($line = <INGAM>)
# {
# @result = ($line =~ "^(\\S+)\$");
# if (@result != 1)
# {
# chop($line);
# &Error(0,"Unexpected Line '$line' From '$cmd'\n");
# &Suggest("Verify '$cmd' Is Working Properly\n");
# &ExitGracefully(1);
# }
# push(@machines,$result[0]);
# }
# close(INGAM);
# unlink($log);
# return(@machines);
#}
##=============================================================================
##
## DoesHostnameExist(hostname)
##
## This routine takes a hostname <hostname>, and returns 1 if the
## hostname is valid, 0 if the hostname is unknown.
##
##=============================================================================
#sub DoesHostnameExist
#{
# local($hostname) = @_;
# local(@result);
# @result = &GetHost($hostname,"name",10);
# return($result[0] ne "");
#}
##=============================================================================
##
## GetHost(key,keytype,timeout)
##
## This routine returns host entry info for the host specified by <key>.
## The <key> value is a string containing either a hostname, or an IP
## address in "dotted string" notation. The <keytype> field indicates
## if the key is a "name" or an "addr".
##
## This routine calls the perl gethostbyname() or gethostbyaddr()
## services respectively, within <timeout> seconds.
##
## On exit, GetHost() returns the host entry array as returned by
## gethostbyaddr() and gethostbyname(). The empty list is returned
## if no match is found.
##
##=============================================================================
sub GetHostTimeoutHandler
{
$GetHostTimeoutHandler_timed_out = 1;
}
sub GetHost
{
local($key,$keytype,$timeout) = @_;
local($old_sig,@host_entry,$packed_addr);
if (($keytype ne "name") && ($keytype ne "addr")){
&InternalError(__LINE__,__FILE__,
"GetHost passed keytype '$keytype'");
}
$GetHostTimeoutHandler_timed_out = 0;
$old_sig = $SIG{'ALRM'};
$SIG{'ALRM'} = 'GetHostTimeoutHandler';
alarm($timeout);
if ($keytype eq "name") {
@host_entry = gethostbyname($key);
} else {
$packed_addr = &DottedAddrToAddr($key);
@host_entry = gethostbyaddr($packed_addr,2);
}
alarm(0);
$SIG{'ALRM'} = $old_sig;
if ($GetHostTimeoutHandler_timed_out) {
&Error(1,"Timeout Looking Up Host Entry For '$key'");
}
#print STDERR "GetHost($key,$keytype,$timeout) -> (" . join(",",@host_entry[0..3]) . ")\n";
return(@host_entry);
}
##=============================================================================
##
## IPAddressToHostname(ip)
##
## This routine takes an IP address <ip>, in "dotted string" notation,
## and looks up the host name for the IP address with a timeout.
##
##=============================================================================
#sub IPAddressToHostname
#{
# local($addr) = @_;
# local(@host_entry,$name);
# if ($addr eq "none") {
# return("");
# }
# @host_entry = &GetHost($addr,"addr",10);
# $name = $host_entry[0];
# if ($name eq "") { $name = $addr; }
##print STDERR "IPAddressToHostname($addr) --> '$name'\n";
# return($name);
#}
##=============================================================================
##
## HostnameToIPAddress(hostname)
##
## This routine takes a host name <hostname> and looks up the IP
## address for the host with a timeout.
##
##=============================================================================
sub HostnameToIPAddress
{
local($name) = @_;
local(@host_entry,$addr);
@host_entry = &GetHost($name,"name",10);
$addr = join(".",unpack("C4",$host_entry[4]));
if ($addr eq ""){
&Error(1,"Couldn't Find IP Address For Host '%s'",$name);
}
return($addr);
}
##=============================================================================
##
## IPAddressToUnambiguousHostname(ip)
##
## This routine takes an IP address <ip>, in "dotted string" notation,
## and converts it to a hostname which, if converted back to an IP
## address, will result in the original IP address.
##
##=============================================================================
sub IPAddressToUnambiguousHostname
{
local($addr) = @_;
local(@host_entry,$name,$newaddr);
# convert address to hostname
@host_entry = &GetHost($addr,"addr",10);
$name = $host_entry[0];
if ($name eq "") { $name = $addr; }
# convert hostname back to address
@host_entry = &GetHost($name,"name",10);
$newaddr = join(".",unpack("C4",$host_entry[4]));
if ($newaddr eq ""){
&Error(1,"IP '$addr' Converts To '$name' Which Is Unbound");
}
# if the addresses are the same, using the name as the
# canonical hostname, otherwise use the dotted string form
# of the address as the canonical hostname
if ($newaddr eq $addr) {
return($name);
}
return($addr);
}
##=============================================================================
##
## CanonicalizeHostname(hostname)
##
## This routine takes a hostname <hostname>, and returns a canonical
## hostname for this interface.
##
##=============================================================================
sub CanonicalizeHostname
{
local($hostname) = @_;
local($addr,$canon);
$addr = &HostnameToIPAddress($hostname);
$canon = &IPAddressToUnambiguousHostname($addr);
&Debug("CanonicalizeHostname(%s) addr: %s canon: %s",
$hostname, $addr, $canon);
return($canon);
}
##=============================================================================
##
## GetHippiInventory()
##
## Parses the output from hinv to determine how many hippi adapters
## (if any) are installed. The device names of each adapter are
## stored in the global variable "@HippiAdapters" and the number of
## adapters is returned.
##
##=============================================================================
#sub GetHippiInventory
#{
# local ($hinv_out, $num_hippi, $hl, $hipsname);
# local (@hinv_list, @hippi_list, @result);
# $hinv_out = `/sbin/hinv 2>&1`;
# if ($? == 0) {
# # hinv successful.
# chop ($hinv_out);
# @hinv_list = split (/\n/, $hinv_out);
# @hippi_list = grep (/HIPPI adapter|HIPPI-Serial adapter/,
# @hinv_list);
# $num_hippi = @hippi_list;
# if ($num_hippi == 0) {
# return (0);
# }
# &Notice("%d HiPPI Interfaces Show Up In Inventory\n",
# $num_hippi);
# if ($Verbose)
# {
# &Notice("@hippi_list\n");
# }
# foreach $hl (@hippi_list)
# {
# if ($hl =~ /HIPPI adapter/) {
# @result = ($hl =~ "^HIPPI adapter: ([^,]+), slot (\\S+) adap (\\S+)");
# if (@result != 3) {
# &Warning("Bad hinv Line (%d) $hl",
# @result);
# return (-1);
# }
# &Notice("HiPPI Interface '%s' Is In Slot %d, Adapt %d\n",
# $result[0],$result[1],$result[2]);
# push(@HippiAdapters,$result[0]);
# }
# else {
# @result = ($hl =~ "^HIPPI-Serial adapter: unit (\\d+), in module (\\d+) I/O slot (\\d+)");
# if (@result != 3) {
# &Warning("Bad hinv Line (%d) $hl",
# @result);
# return (-1);
# }
# $hipsname = "hippi$result[0]";
# &Notice("HiPPI-Serial Interface '%s' Is In Module %d, Slot %d\n",
# $hipsname,$result[1],$result[2]);
# push(@HippiAdapters,$hipsname);
# }
# }
# }
# else {
# # $? != 0; i.e., hinv failed.
# &Warning("Couldn't Run 'hinv' to determine presence of HiPPI devices\n");
# return (-1);
# }
# return ($num_hippi);
#}
##=============================================================================
##
## ParseImapFile(filename)
##
## This routine parses the imap file <filename>, usually
## /usr/etc/hippi.imap, and extracts the hostname to I-Field mappings.
## The mappings are returned as a list of strings. Each string is a
## space-separated value consisting of <interfacename>, <ifield>, and
## optional <ula>.
##
##=============================================================================
#sub ParseImapFile
#{
# local($file) = @_;
# local($line,$lineno,$entry,$warnings,@r3,@r2,@r1,@r,@entries);
# open(IN,"$file") || &Error(1,"Can't Open '$file'\n");
# $lineno = 0;
# $warnings = 0;
# while ($line = <IN>)
# {
# ++ $lineno;
# chop($line);
# @r = ();
# ($line) = ($line =~ "^([^#]*)");
# @r3 = ($line =~ "^\\s*(\\S+)\\s+(\\S+)\\s+(\\S+)");
# @r2 = ($line =~ "^\\s*(\\S+)\\s+(\\S+)");
# if (@r3 == 3) { @r = @r3; }
# elsif (@r2 == 2) { @r = (@r2,""); }
# elsif (@r1 == 1)
# {
# &Warning("Line %d Of '%s' Has Single Field Entry\n",
# $lineno,$file);
# ++ $warnings;
# }
# if (@r == 3)
# {
# push(@entries,join(" ",@r));
# if (! ($r[1] =~ /^0x/))
# {
# &Warning("Line %d Of '%s' Has Ifield Without '0x' Prefix\n",
# $lineno,$file);
# ++ $warnings;
# }
# }
# }
# close(IN);
# if ($warnings) { &Suggest("$warnings Warnings, Ensure '$file' Is Correct\n"); }
# return(@entries);
#}
##=============================================================================
##
## ParseIfield(ifield)
##
## This routine takes an Ifield in hexadecimal if begins with 0x, or
## decimal otherwise, an returns a decoded list, consisting of:
##
## ($L,$VU,$W,$D,$PS,$C,$RC)
##
## Where: $L is 0 or 1, 1 meaning locally-defined protocol
## $VU is 0 to 3, for vendor use
## $W is 32 or 64, for bus size
## $D is "LSB" or "MSB", the direction of address consumption
## $PS is "Source", "Logical", "RSVD", and "Logical (Best)"
## $C is "Camp" or "NoCamp"
## $RC is the routing path, a 24 bit hexadecimal number string
##
##=============================================================================
#sub ParseIfield
#{
# local($ifield) = @_;
# local($t,$L,$VU,$W,$D,$PS,$C,$RC);
# if ($ifield =~ /^0x/) { $ifield = oct($ifield); }
# $L = ($ifield >> 31) & 1;
# $VU = ($ifield >> 29) & 3;
# $W = (($ifield >> 28) & 1 ? 64 : 32);
# $D = (($ifield >> 27) & 1 ? "MSB" : "LSB");
# $t = ($ifield >> 25) & 3;
# if ($t == 0) { $PS = "Source"; }
# elsif ($t == 1) { $PS = "Logical"; }
# elsif ($t == 2) { $PS = "RSVD"; }
# elsif ($t == 3) { $PS = "Logical (Best)"; }
# $C = (($ifield >> 24) & 1 ? "Camp" : "NoCamp");
# $RC = sprintf("0x%06X",($ifield & 0xFFFFFF));
# return($L,$VU,$W,$D,$PS,$C,$RC);
#}
##=============================================================================
##
## HostnameToIfield(hostname)
##
## This routine takes a hostname of a HIPPI device, reads in
## /usr/etc/hippi.imap, and returns a string containing the hex Ifield
## corresponding to the interface, preceded with 0x. The empty string
## is returned on error.
##
##=============================================================================
#sub HostnameToIfield
#{
# local($hostname) = @_;
# local(@imap_entries,$entry,$h,$i,$u,$target_ip,$ip);
# $target_ip = &HostnameToIPAddress($hostname);
# @imap_entries = &ParseImapFile("/usr/etc/hippi.imap");
# foreach $entry (@imap_entries)
# {
# ($h,$i,$u) = split(" ",$entry);
# $ip = &HostnameToIPAddress($h);
# if ($ip eq $target_ip)
# {
# return($i);
# }
# }
# return("");
#}
##=============================================================================
##
## DeviceNameToIfield(device,errorsfatal)
##
## This routine takes a HIPPI device name and returns an ifield bound
## to the device. This is done by finding the IP address bound to the
## device, and searching the hippi.imap file for the ifield.
##
## If no IP address is bound to the device, this routine will either
## fail with an error message, if <errorsfatal> is set, or return an
## empty string.
##
##=============================================================================
#sub DeviceNameToIfield
#{
# local($device,$errorsfatal) = @_;
# local($hippi_number,$ip,$ifield,@result);
# $ifield = "";
# @result = ($device =~ /hippi(\d+)/);
# if (@result != 1)
# {
# &Error(1,"Unexpected HIPPI Device '$device'\n");
# }
# @result = &GetIPByDeviceName("hip" . $result[0]);
# if (@result >= 2)
# {
# $ip = $result[1];
# $ifield = &HostnameToIfield($ip);
# }
# else
# {
# if (! $errorsfatal) { return(""); }
# &Error(0,"Couldn't Find IP Address For Device '$device'\n");
# &Suggest("Ensure Device '$device' Is Network Configured\n");
# &ExitGracefully(1);
# }
# if ($ifield eq "")
# {
# if (! $errorsfatal) { return(""); }
# &Error(0,"Couldn't Find Ifield For HIPPI Device '$device' ($ip)\n");
# &Suggest("(1) Verify IP Address '$ip' (Or An **Alias) Is In '/usr/etc/hippi.imap'\n");
# &Suggest("(2) Verify Device '$device' Should Have IP Address '$ip'\n");
# &ExitGracefully(1);
# }
# return($ifield);
#}
#=============================================================================
#
# AddSignalHandler(signal,functionname)
#
# This routine adds the subroutine <functionname> to the list of
# routines that are called when the signal <signal> is invoked.
# Remove signal handlers from a signal with RemoveSignalHandler().
# Signal handlers should not normally terminate, in order to allow
# other signal handlers in the list to execute. The global variable
# $terminate_after_signal can be set by the signal handler to terminate
# after the last signal handler is called.
#
# This code won't work well for timeouts, because there is no
# virtualization of timers.
#
#=============================================================================
sub AddSignalHandler
{
local($signal,$functionname) = @_;
local($h,$current,$handlers_string,@handlers);
$handlers_string = $signal_handlers{$signal};
@handlers = ();
@handlers = split(' ',$handlers_string) if (defined($handlers_string));
push(@handlers,$functionname);
$current = $SIG{$signal};
if (! defined($current)) {
$current = "DEFAULT";
}
if ($current ne "main'SignalHandler") {
if (($current ne "DEFAULT") &&
($current ne "IGNORE")) {
&InternalError(__LINE__,__FILE__,
"AddSignalHandler Has Current Handler '%s'\n",
$current);
}
@handlers = ($current,@handlers);
}
$signal_handlers{$signal} = join(" ",@handlers);
$SIG{$signal} = "SignalHandler";
}
##=============================================================================
##
## RemoveSignalHandler(signal,functionname)
##
## This routine removes the subroutine <functionname> from the list of
## routines that are called when the signal <signal> is invoked.
## If the handler you remove is the last one added, the value of the
## handler before the first AddSignalHandler() call is restored.
##
##=============================================================================
#sub RemoveSignalHandler
#{
# local($signal,$functionname) = @_;
# local($found,$h,$current,$handlers_string,$orig,@handlers);
# $handlers_string = $signal_handlers{$signal};
# ($orig,@handlers) = split(' ',$handlers_string);
# $found = 0;
# for ($i = 0; $i <= $#handlers; $i++)
# {
# if ($handlers[$i] eq $functionname)
# {
# splice(@handlers,$i,1);
# $found = 1;
# last;
# }
# }
# if (!$found)
# {
# &InternalError(__LINE__,__FILE__,
# "RemoveSignalHandler Can't Find Handler '%s'\n",
# $functionname);
# }
# if (@handlers == 0)
# {
# $SIG{$signal} = $orig;
# delete($signal_handlers{$signal});
# }
# else
# {
# @handlers = ($orig,@handlers);
# $signal_handlers{$signal} = join(" ",@handlers);
# }
#}
##=============================================================================
##
## EnsureFileExists(pathname)
##
## This routine file a program <pathname> exists and is readable.
##
##=============================================================================
#sub EnsureFileExists
#{
# local($path) = @_;
# if (! (-e $path))
# {
# &Error(1,"File '%s' Doesn't Exist\n",$path);
# }
# if (! (-r $path))
# {
# &Error(1,"File '%s' Not Readable\n",$path);
# }
#}
##=============================================================================
##
## EnsureProgramExists(pathname)
##
## This routine ensures a program <pathname> exists and is executable.
##
##=============================================================================
#sub EnsureProgramExists
#{
# local($path) = @_;
# if (! (-e $path))
# {
# &Error(1,"Program '%s' Doesn't Exist\n",$path);
# }
# if (! (-x $path))
# {
# &Error(1,"Program '%s' Not Executable\n",$path);
# }
#}
##=============================================================================
##
## DottedAddrToAddr
##
## Perl doesn't seem to be too friendly to us. It makes us do name
## resolution using binary structures, but doesn't seem to provide
## any inet_XtoY kind of stuff. This routine converts a dotted string
## IP address into a binary encoding.
##
##=============================================================================
sub DottedAddrToAddr
{
local($dotted) = @_;
local($binary,@fields);
@fields = split("\\.",$dotted);
if (@fields != 4) {
&Error(1,"Not Four Fields In Addr '$dotted' (@fields)");
}
$binary = pack("C4",@fields);
return($binary);
}
##=============================================================================
##
## AddrToDottedAddr
##
## Perl doesn't seem to be too friendly to us. It makes us do name
## resolution using binary structures, but doesn't seem to provide
## any inet_XtoY kind of stuff. This routine converts a binary encoded
## IP address into a dotted string.
##
##=============================================================================
#sub AddrToDottedAddr
#{
# local($binary) = @_;
# local($dotted,@fields);
# @fields = unpack("C4",$binary);
# if (@fields != 4)
# {
# &InternalError(__LINE__,__FILE__,
# "Not Four Fields In Packed Address\n");
# }
# $dotted = join(".",@fields);
# return($dotted);
#}
#####################################################################
## SUBROUTINE GET_REMOTE_FILE #
## Gets the contents of remote_file from the remote_host, and #
## returns that to the caller. #
## If the file does not exist or is unreadable, it returns the #
## corresponding cat error msg. #
#####################################################################
#sub get_remote_file {
# local ($remote_host, $remote_file, $timeout) = @_;
# local ($cat_cmd, $cat_out);
# $cat_cmd = "/usr/bsd/rsh $remote_host -n /sbin/cat -u $remote_file";
# $cat_out = &do_cmd_with_timeout ($cat_cmd, $timeout);
# if ($? == 0) {
# ##############################################################
# # Check the output to see if cat gave an error msg. These #
# # msgs look like: UX:cat: ERROR: ... #
# # No, actually let the caller take care of it ... #
# ##############################################################
# return ($cat_out);
# }
# else {
# &Error(1,"Remote Command '$cat_cmd' Failed With Output:\n$cat_out");
# }
#} # end of "sub get_remote_file"
######################################################################
## SUBROUTINE DO_CMD_WITH_TIMEOUT #
## Executes the command with timeout. Sets the signal handler for #
## SIGALRM to lanarray_alrm_handler, resetting it back to the orig. #
## afterwards.
######################################################################
sub do_cmd_with_timeout {
local ($next_cmd, $timeout) = @_;
local ($old_sig);
local ($command);
$old_sig = $SIG{'ALRM'}; # Save old handler name.
$SIG{'ALRM'} = \&alarm_call;
$command="\'$next_cmd ; echo \$?;\'";
&Log ("Executing command $command");
alarm ($timeout); # Enable timeout.
eval {@next_cmd_out = `$next_cmd `};
alarm (0); # Disable timeout.
$SIG{'ALRM'} = $old_sig; # Reset handler to whatever it was before.
if ($SIG_TIMEOUT) {
$RSH_ERRNO=1;
return $NULL;
}
if ($@ ne "") {
&Failure("command failure $@\n");
return ($NULL);
}
$RSH_ERRNO=$next_cmd_out[scalar(@next_cmd_out)-1];
chop (@next_cmd_out);
return (@next_cmd_out);
} # end of "sub do_cmd_with_timeout"
sub do_log {
local ($next_cmd, $timeout) = @_;
local ($old_sig);
$old_sig = $SIG{'ALRM'}; # Save old handler name.
$SIG{'ALRM'} = 'lanarray_alrm_handler';
alarm ($timeout); # Enable timeout.
$next_cmd_out = `$next_cmd 2>&1`;
alarm (0); # Disable timeout.
$SIG{'ALRM'} = $old_sig; # Reset handler to whatever it was before.
chop ($next_cmd_out);
return ($next_cmd_out);
}
######################################################################
## SUBROUTINE LANARRAY_ALRM_HANDLER #
## This routine is the SIGALRM handler used for the timeout function #
## in lantest and arraysvcstest. #
######################################################################
sub lanarray_alrm_handler {
local ($sig_num) = @_;
local ($this_cmd_pid, $this_cmd_ps_out);
local ($num_killed);
# Kill all my children before exiting.
$num_killed = &kill_all_children;
&Error(0,"Operation Timed Out");
&Suggest("(1) If Nodes In Use, Load May Be Too High");
&Suggest("(2) Try Running Diags Again If Suspect It's A Startup Delay");
&ExitGracefully(1);
} # end of "sub lanarray_alrm_handler"
#####################################################################
## SUBROUTINE KILL_ALL_CHILDREN #
## This routine kills all the children processes of this process. #
## Returns the number of children killed. #
#####################################################################
sub kill_all_children {
local($count, @ppid_list, @pid_list, $this_ppid);
local($ps_out, @ps_list, $ps_line, @ps_fields, $this_pid);
$count = 0;
$ps_out = `/sbin/ps -ef`;
chop($ps_out);
@ps_list = split (/\n/, $ps_out);
push(@ppid_list, $$);
while (@ppid_list) {
$this_ppid = shift(@ppid_list);
foreach $ps_line (@ps_list) {
@ps_fields = split (' ', $ps_line);
if ($ps_fields[2] == $this_ppid) {
push(@ppid_list, $ps_fields[1]);
push(@pid_list, $ps_fields[1]);
}
}
} # while (@ppid_list)
## FIX!! Make the pid_list associative, to clean up recursively.
foreach $this_pid (@pid_list) {
if (kill(9, $this_pid) != 0) {
$count++;
}
}
return ($count);
} # end of "sub kill_all_children"
###############################################################################
##
## I N T E R N A L R O U T I N E S
##
## (get your nose out of here)
##
###############################################################################
##=============================================================================
##
## SignalHandler(signal)
##
## This routine is the entry point for a signal handler. It calls
## all the user specified signal handlers that were attached to this
## signal handler, and then, if $terminate_after_signal is true, exits
## the application with error code $terminate_after_signal.
##
##=============================================================================
sub SignalHandler
{
local($signal) = @_;
local($h,$handlers_string,@handlers);
&Notice("$0 Caught Signal '$signal'\n");
$handlers_string = $signal_handlers{$signal};
@handlers = split(' ',$handlers_string);
shift(@handlers);
if (@handlers == 0)
{
&InternalError(__LINE__,__FILE__,
"SignalHandler Without Handlers\n");
}
$terminate_after_signal = 0;
&Notice("Calling Interrupt Handlers [%s]\n",join(" ",@handlers));
foreach $h (@handlers)
{
eval("&"."$h"."($signal)");
if ($@ != "")
{
&InternalError(__LINE__,__FILE__,
"SignalHandler Invoke Says '$@'\n");
}
}
if ($terminate_after_signal != 0)
{
&ExitGracefully($terminate_after_signal);
}
$SIG{$signal} = "SignalHandler";
}
##=============================================================================
##
## CleanUp
##
## This routine is called before program exit to remove temporary
## files and otherwise clean up after itself.
##
##=============================================================================
sub CleanUp
{
local($fc,$f,$c);
# &Notice("Cleaning Up Before Program '$0' Exits\n");
foreach $fc (@files_to_clean) {
($f,$c) = split(":",$fc);
if (-e $f) {
&Notice("Deleting Temp File '%s' (%s)\n",$f,$c);
unlink($f);
}
}
}
##=============================================================================
##
## UnexpectedSignalHandler
##
## Clean up and exit with error 1.
##
##=============================================================================
sub UnexpectedSignalHandler
{
&ExitGracefully(1);
}
#sub SpawnCommand
#{
# local($command) = @_;
# local($child_pid,$out_file);
# $out_file = &MakeTempFile("/usr/tmp");
# $child_pid = fork();
# if ($child_pid == 0) # The Child Process
# {
# close(STDIN);
# close(STDOUT);
# setpgrp(0,$$);
# exec("$command >$out_file 2>&1");
# exit(0);
# }
# elsif ($child_pid > 0)
# { # The Parent Process
# return($child_pid,$out_file);
# }
# else
# {
# return(-1,"");
# }
#}
sub TimeoutHandler
{
local($pid,$done);
##
## Kill All Outstanding Commands
##
foreach $pid (keys(%DONE))
{
$done = $DONE{$pid};
if ($done == 0)
{
$DONE{$pid} = 2; # Timed out status
kill(-9,$pid);
}
}
$timed_out = 1;
}
#=============================================================================
#
# MapFuncToStream(function,stream-name)
#
# This function opens a stream, reads in each line from the stream,
# and applies the perl function name to the each line. The function
# should return 0 for immediate termination, 1 to continue processing.
#
#=============================================================================
#sub MapFuncToStream
#{
# local($func,$stream_path) = @_;
# local($line,$cmd,$result);
# open(MFTS_IN,$stream_path) ||
# &Error("can't open stream '$stream_path'\n");
# while ($line = <MFTS_IN>)
# {
# chop($line);
# $cmd = "&" . "$func" . "(\"$line\");";
# $result = eval($cmd);
# if ($result eq undef)
# {
# chop($@);
# &InternalError("MapFuncToStream",$@);
# }
# if ($result == 0) { last; }
# }
# close(MFTS_IN);
#}
#=============================================================================
#
# Executable Commands
#
#=============================================================================
&AddSignalHandler("INT","UnexpectedSignalHandler");
&AddSignalHandler("SEGV","UnexpectedSignalHandler");
&AddSignalHandler("BUS","UnexpectedSignalHandler");
&AddSignalHandler("HUP","UnexpectedSignalHandler");
&AddSignalHandler("PIPE","UnexpectedSignalHandler");
#
# The following is for [x]emacs...
# Local Variables:
# perl-indent-level:8
# End: